home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / COMM / PPL4P10A / XYMODEM.PAS < prev    next >
Pascal/Delphi Source File  |  1995-02-20  |  14KB  |  470 lines
  1. (**********************************************)
  2. (*        Copyright (C) 1995 by               *)
  3. (*     MarshallSoft Computing, Inc.           *)
  4. (**********************************************)
  5.  
  6. { $DEFINE DEBUG}
  7. {$I DEFINES.PAS}
  8.  
  9.  
  10. unit xymodem;
  11.  
  12. interface
  13.  
  14. uses xypacket,term_io,crt,dos,file_io,PCL4P;
  15.  
  16. function XmodemTx(
  17.          Port     : Integer;     (* COM port [COM1,COM2,...] *)
  18.      Var Filename : String;      (* filename buffer *)
  19.          OneKflag : Boolean)     (* 1K flag *)
  20.        : Boolean;
  21.  
  22. function XmodemRx(
  23.          Port     : Integer;     (* COM port [COM1,COM2,...] *)
  24.      Var Filename : String;      (* filename buffer *)
  25.          NCGbyte  : Byte)        (* NAK, 'C', or 'G' *)
  26.        : Boolean;
  27.  
  28. function YmodemTx(
  29.          Port     : Integer;     (* COM port [COM1,COM2,...] *)
  30.      Var Filespec : String;      (* file spec buffer *)
  31.          OneKflag : Boolean)     (* 1K flag *)
  32.        : Boolean;
  33.  
  34. function YmodemRx(
  35.          Port     : Integer;     (* COM port [COM1,COM2,...] *)
  36.      Var Filename : String;      (* filename buffer *)
  37.          NCGbyte  : Byte)        (* NAK, 'C', or 'G' *)
  38.        : Boolean;
  39.  
  40. implementation
  41.  
  42. Const NAK = $15;
  43.       CAN = $18;
  44.       ESC = $1B;
  45.  
  46. Var
  47.   Buffer : BufferType;
  48.  
  49.  
  50. function TxyModem(
  51.          Port     : Integer;     (* COM port [COM1,COM2,...] *)
  52.      Var Filename : String;      (* filename buffer *)
  53.          OneKflag : Boolean;     (* use 1K blocks when possible *)
  54.          BatchFlag: Boolean)     (* send filename in packet 0 *)
  55.        : Boolean;
  56. Label 999;
  57. Var
  58.   i, k   : Integer;
  59.   Code   : Integer;
  60.   Flag   : Boolean;
  61.   c      : Char;
  62.   Packet     : Integer;
  63.   PacketType : Char;
  64.   PacketNbr  : Byte;
  65.   BlockSize  : Word;
  66.   ReadSize   : Word;
  67.   FirstPacket: Word;
  68.   EOTflag    : Boolean;
  69.   CheckSum   : Word;
  70.   Number1K   : Word;       (* total # 1K ( 8 records ) packets *)
  71.   Number128  : Word;       (* total # 128 byte ( 1 record ) packets *)
  72.   NCGbyte    : Byte;
  73.   FileBytes  : LongInt;
  74.   RemainingBytes : LongInt;
  75.   EmptyFlag : Boolean;
  76.   Message   : String;
  77.   Temp1  : String;
  78.   Temp2  : String;
  79.   Result : Word;
  80.   CPS  : Integer;
  81.   Tics : LongInt;
  82.   Secs : LongInt;
  83. begin
  84.  (* begin *)
  85.  fioInit;
  86.  BlockSize := 128;
  87.  Number128 := 0;
  88.  Number1K := 0;
  89.  NCGbyte := NAK;
  90.  EmptyFlag := FALSE;
  91.  EOTflag := FALSE;
  92.  if BatchFlag then
  93.    begin
  94.      if (Length(Filename)=0) then EmptyFlag := TRUE;
  95.    end;
  96.  if not EmptyFlag then
  97.    begin (* not EmptyFlag *)
  98.      if not fioOpen(Filename) then
  99.        begin
  100.          Message := 'Cannot open ' + Filename;
  101.          WriteMsg(Message);
  102.          TxyModem := FALSE;
  103.          goto 999;
  104.        end;
  105.      (* pre-read 1st block *)
  106.      fioPreRead;
  107.    end; (* not EmptyFlag *)
  108.  WriteMsg('XYMODEM send: waiting for receiver ');
  109.  (* compute # blocks *)
  110.  if EmptyFlag then
  111.    begin (* empty file *)
  112.      Number128 := 0;
  113.      Number1K := 0
  114.    end
  115.  else
  116.    begin (* file not empty *)
  117.      FileBytes := fioSize;
  118.      RemainingBytes := FileBytes;
  119.      if OneKflag
  120.        then Number1K := FileBytes div 1024
  121.        else Number1K := 0;
  122.      Number128 := (FileBytes - 1024 * Number1K) div 128;
  123.      if (128*Number128+1024*Number1K) < FileBytes
  124.         then Number128 := Number128 + 1;
  125.      Str(Number1K,Temp1);
  126.      Str(Number128,Temp2);
  127.      Message := Temp1+' 1K & '+Temp2+' 128-byte packets';
  128.      WriteMsg(Message);
  129.    end;
  130.  (* clear comm port [there may be several NAKs queued up] *)
  131.  Code := SioRxFlush(Port);
  132.  (* get receivers start up NAK or 'C' *)
  133.  if not TxStartup(Port,NCGbyte) then
  134.    begin
  135.      TxyModem := FALSE;
  136.      goto 999;
  137.    end;
  138.  (* loop over all packets *)
  139.  if BatchFlag
  140.    then FirstPacket := 0
  141.    else FirstPacket := 1;
  142.  (* transmit each packet in turn *)
  143.  Tics := SioTimer;
  144.  for Packet := FirstPacket to Number1K+Number128 do
  145.    begin
  146.       {$IFDEF DEBUG}
  147.       WriteLn('Packet=',Packet);
  148.       {$ENDIF}
  149.       (* user aborts ? *)
  150.       if KeyPressed then if (Ord(ReadKey) = CAN) then
  151.         begin
  152.            TxCAN(Port);
  153.            WriteMsg('Canceled by USER');
  154.            TxyModem := FALSE;
  155.            goto 999
  156.         end;
  157.      (* issue message *)
  158.      str(Packet,Temp1);
  159.      Message := 'Packet ' + Temp1;
  160.      WriteMsg(Message);
  161.      (* load up Buffer *)
  162.      if Packet=0 then
  163.        begin (* packet = 0 *)
  164.          if EmptyFlag then Buffer[0] := 0
  165.          else
  166.            begin (* not empty *)
  167.              (* copy filename to buffer *)
  168.              BlockSize := 128;
  169.              k := 0;
  170.              WriteLn('Sending ',Filename);
  171.              for i:= 1 to Length(Filename) do
  172.                begin
  173.                  Buffer[k] := ord(Filename[i]);
  174.                  k := k + 1;
  175.                end;
  176.              Buffer[k] := 0;
  177.              (* copy file length to buffer *)
  178.              k := k + 1;
  179.              Str(FileBytes,Temp1);
  180.              for i := 1 to Length(Temp1) do
  181.                begin
  182.                  Buffer[k] := ord(Temp1[i]);
  183.                  k := k + 1;
  184.                end;
  185.              (* pad remainder of buffer *)
  186.              for i := k to 127 do Buffer[i] := 0;
  187.            end (* not empty *)
  188.         end (* Packet = 0 *)
  189.       else
  190.         begin (* Packet > 0 *)
  191.           (* DATA Packet: use 1K or 128-byte blocks ? *)
  192.           if BatchFlag and (Packet <= Number1K)
  193.             then BlockSize := 1024
  194.             else BlockSize := 128;
  195.           (* compute # bytes to read *)
  196.           if RemainingBytes < BlockSize then ReadSize := RemainingBytes
  197.           else ReadSize := BlockSize;
  198.           (* read next block from disk *)
  199.           if not fioRead(Buffer,ReadSize,Result) then
  200.             begin
  201.               WriteMsg('Disk I/O error');
  202.               TxyModem := FALSE;
  203.               goto 999
  204.             end;
  205.           RemainingBytes := RemainingBytes - Result;
  206.           if Result <> ReadSize then
  207.             begin
  208.               WriteMsg('Unexpected EOF on disk read');
  209.               TxyModem := FALSE;
  210.               goto 999;
  211.             end;
  212.           (* pad short buffer with ^Z *)
  213.           if ReadSize < BlockSize then
  214.             for i:= ReadSize to BlockSize do Buffer[i] := $1A;
  215.         end; (* Packet > 0 *)
  216.      (* send this packet *)
  217.      if not TxPacket(Port,Packet,BlockSize,Buffer,NCGbyte) then
  218.        begin
  219.          TxyModem := FALSE;
  220.          goto 999
  221.        end;
  222.      (* must 'restart' after non null packet 0 *)
  223.      if (not EmptyFlag) and (Packet=0) then Flag := TxStartup(Port,NCGbyte);
  224.    end; (* end -- for(Packet) *)
  225.  (* done if empty packet 0 *)
  226.  if EmptyFlag then
  227.    begin
  228.      WriteMsg('Batch transfer completed');
  229.      TxyModem := TRUE;
  230.      goto 999;
  231.    end
  232.  else
  233.    begin
  234.      (* compute CPS *)
  235.      Secs := (SioTimer - Tics) div 18;
  236.      If Secs > 0 then CPS := Integer(FileBytes div Secs)
  237.      else CPS := 0;
  238.      WriteLn(Filename,' sent @ CPS = ',CPS);
  239.    end;
  240.  (* all done. send EOT up to 10 times *)
  241.  fioClose;
  242.  if not TxEOT(Port) then
  243.    begin
  244.      SayError(Port,'EOT not acknowledged');
  245.      TxyModem := FALSE;
  246.      goto 999;
  247.    end;
  248.  WriteMsg('Transfer completed');
  249.  TxyModem := TRUE;
  250. 999: end; (* end -- TxyModem *)
  251.  
  252. function RxyModem(
  253.          Port     : Integer;        (* COM port [COM1,COM2,...] *)
  254.      Var Filename : String;         (* filename buffer *)
  255.          NCGbyte  : Byte;           (* NAK, 'C', or 'G' *)
  256.          BatchFlag: Boolean)        (* get filename from packet 0 *)
  257.        : Boolean;
  258. Label 999;
  259. Var
  260.   i, k    : Integer;
  261.   Packet  : Integer;      (* packet index *)
  262.   Code    : Integer;      (* return code *)
  263.   Flag    : Boolean;
  264.   EOTflag : Boolean;
  265.   Message : String;
  266.   Temp    : String;
  267.   Result  : Integer;
  268.   CPS     : Integer;
  269.   Tics    : LongInt;
  270.   Secs    : LongInt;
  271.   FirstPacket: Word;
  272.   PacketNbr  : Byte;
  273.   FileBytes  : LongInt;
  274.   BytesRX    : LongInt;
  275.   EmptyFlag  : Boolean;
  276.   PacketSize : Word;
  277.   (* begin *)
  278. begin
  279.   fioInit;
  280.   BytesRX := 0;
  281.   EmptyFlag := FALSE;
  282.   EOTflag := FALSE;
  283.   WriteMsg('XYMODEM Receive: Waiting for Sender ');
  284.   (* clear comm port *)
  285.   Code := SioRxFlush(Port);
  286.   (* Send NAKs or 'C's *)
  287.   if not RxStartup(Port,NCGbyte) then
  288.     begin
  289.       RxyModem := FALSE;
  290.       goto 999;
  291.     end;
  292.   (* open file unless BatchFlag is on *)
  293.   if BatchFlag then FirstPacket := 0
  294.   else
  295.     begin (* not BatchFlag *)
  296.       FirstPacket := 1;
  297.       (* open Filename for write *)
  298.       if not fioCreate(Filename) then
  299.         begin
  300.           Message := 'Cannot open ' + Filename;
  301.           WriteMsg(Message);
  302.           RxyModem := FALSE;
  303.           goto 999;
  304.         end;
  305.     end; (* not BatchFlag *)
  306.   Tics := SioTimer;
  307.   (* get each packet in turn *)
  308.   for Packet := FirstPacket to MaxInt do
  309.     begin
  310.       {$IFDEF DEBUG}
  311.       WriteLn('Packet=',Packet);
  312.       {$ENDIF}
  313.       (* user aborts ? *)
  314.       if KeyPressed then if (Ord(ReadKey) = CAN) then
  315.         begin
  316.            TxCAN(Port);
  317.            WriteMsg('Canceled by USER');
  318.            RxyModem := FALSE;
  319.            goto 999
  320.         end;
  321.       (* issue message *)
  322.       str(Packet,Temp);
  323.       Message := 'Packet ' + Temp;
  324.       WriteMsg(Message);
  325.       PacketNbr := Packet AND $00ff;
  326.       (* get next packet *)
  327.       if not RxPacket(Port,Packet,PacketSize,Buffer,NCGbyte,EOTflag) then
  328.         begin
  329.           RxyModem := FALSE;
  330.           goto 999;
  331.         end;
  332.       (* packet 0 ? *)
  333.       if Packet = 0 then
  334.         begin (* Packet = 0 *)
  335.           if Buffer[0] = 0 then
  336.             begin
  337.               WriteMsg('Batch transfer complete');
  338.               RxyModem := TRUE;
  339.               goto 999;
  340.             end;
  341.           (* get filename *)
  342.           i := 0;
  343.           k := 1;
  344.           repeat
  345.             Filename[k] := chr(Buffer[i]);
  346.             i := i + 1;
  347.             k := k + 1;
  348.           until Buffer[i] = 0;
  349.           FileName[0] := chr(i);
  350.           (* get file size *)
  351.           i := i + 1;
  352.           k := 1;
  353.           repeat
  354.             Temp[k] := chr(Buffer[i]);
  355.             i := i + 1;
  356.             k := k + 1;
  357.           until Buffer[i] = 0;
  358.           Temp[0] := chr(k - 1);
  359.           Val(Temp,FileBytes,Result);
  360.           WriteLn('Receiving ',Filename);
  361.        end; (* Packet = 0 *)
  362.     (* all done if EOT was received *)
  363.     if EOTflag then
  364.       begin
  365.         Secs := (SioTimer - Tics) div 18;
  366.         If Secs > 0 then CPS := Integer(BytesRX div Secs)
  367.         else CPS := 0;
  368.         WriteLn(Filename,' received @ CPS = ',CPS);
  369.         fioClose;
  370.         WriteMsg('Transfer completed');
  371.         RxyModem := TRUE;
  372.         goto 999
  373.       end;
  374.     (* process the packet *)
  375.     if Packet = 0 then
  376.       begin
  377.         (* open file using filename in packet 0 *)
  378.         if not fioCreate(Filename) then
  379.           begin
  380.             Message := 'Cannot open ' + Filename;
  381.             WriteMsg(Message);
  382.             RxyModem := FALSE;
  383.             goto 999;
  384.           end;
  385.         (* must 'restart' after packet 0 *)
  386.         Flag := RxStartup(Port,NCGbyte);
  387.       end
  388.     else (* Packet > 0 [DATA packet] *)
  389.       begin (* write Buffer *)
  390.         if not fioWrite(Buffer,PacketSize) then
  391.           begin
  392.             WriteMsg('Disk I/O error');
  393.             RxyModem := FALSE;
  394.             goto 999
  395.           end;
  396.         BytesRX := BytesRX + PacketSize
  397.       end (* end -- else *)
  398.   end; (* end -- for(Packet) *)
  399. 999:end; (* end - RxyModem *)
  400.  
  401. function XmodemTx(
  402.          Port     : Integer;        (* COM port [COM1,COM2,...] *)
  403.      Var Filename : String;         (* filename buffer *)
  404.          OneKflag : Boolean)        (* 1K flag *)
  405.        : Boolean;
  406. begin
  407.   if FetchName(Filename) then
  408.     XmodemTx := TxyModem(Port,Filename,OneKflag,False)
  409.   else XmodemTx := False;
  410. end;
  411.  
  412. function XmodemRx(
  413.          Port     : Integer;        (* COM port [COM1,COM2,...] *)
  414.      Var Filename : String;         (* filename buffer *)
  415.          NCGbyte  : Byte)           (* NAK, 'C', or 'G' *)
  416.        : Boolean;
  417. begin
  418.   if FetchName(Filename) then
  419.     XmodemRx := RxyModem(Port,Filename,NCGbyte,False)
  420.   else XmodemRx := False;
  421. end;
  422.  
  423.  
  424. function YmodemTx(
  425.          Port     : Integer;        (* COM port [COM1,COM2,...] *)
  426.      Var Filespec : String;         (* file spec buffer *)
  427.          OneKflag : Boolean)        (* 1K flag *)
  428.        : Boolean;
  429. Var
  430.   FileNbr  : Integer;
  431.   DirInfo  : SearchRec;
  432.   Filename : String;
  433. begin
  434.   FileNbr := 0;
  435.   if FetchName(Filespec) then
  436.     repeat
  437.       FileNbr := FileNbr + 1;
  438.       if FileNbr = 1 then FindFirst(Filespec,AnyFile,DirInfo)
  439.       else FindNext(DirInfo);
  440.       if DosError <> 0 then
  441.         begin
  442.           (* send empty filename *)
  443.           Filename := '';
  444.           YmodemTx := TxyModem(Port,Filename,OneKflag,True);
  445.           exit;
  446.         end;
  447.       Filename := DirInfo.Name;
  448.       YmodemTx := TxyModem(Port,Filename,OneKflag,True);
  449.     until False;
  450. end;
  451.  
  452. function YmodemRx(
  453.          Port     : Integer;        (* COM port [COM1,COM2,...] *)
  454.      Var Filename : String;         (* filename buffer *)
  455.          NCGbyte  : Byte)           (* NAK, 'C', or 'G' *)
  456.        : Boolean;
  457. begin
  458.   YmodemRx := True;
  459.   repeat
  460.     WriteMsg('Ready for next file');
  461.     Filename := '';
  462.     if not RxyModem(Port,Filename,NCGbyte,True) then
  463.     begin
  464.       YmodemRx := False;
  465.       exit
  466.     end
  467.   until KeyPressed or (Length(Filename) = 0)
  468. end;
  469.  
  470. end.